
module Main where

-- import System( getArgs )

import Text.Parsec
-- import Text.Parsec.Pos
import Text.Parsec.Expr
import Text.Parsec.String
import Text.Parsec.Language

import qualified Text.Parsec.Token as Token

-- import Control.Monad
-- import Control.Monad.State
import Control.Monad.Identity
import Control.Monad.Error
-- import Data.Maybe
-- import qualified Data.Map as Map

whitespaceChars :: String
whitespaceChars = " \n\r\t"
operatorChars :: String
operatorChars = "" -- "`~!@$%^&*()-+=[]{};:<>,./?\\|" 
identChars :: String
identChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_"

elsieStyle :: LanguageDef st
elsieStyle = emptyDef
                { Token.commentStart   = "{-"
                , Token.commentEnd     = "-}"
                , Token.commentLine    = "--"
                , Token.nestedComments = True
                , Token.identStart     = letter
                , Token.identLetter    = alphaNum <|> oneOf "_'"
                , Token.opStart        = Token.opLetter elsieStyle
                , Token.opLetter       = oneOf operatorChars
                , Token.reservedOpNames= []
                , Token.reservedNames  = []
                , Token.caseSensitive  = True
                }
                
lexer :: Token.TokenParser st
lexer = Token.makeTokenParser elsieStyle

{-
	
	int (name)(int,int,char);
	typedef int (*name) (void);
the typedef name is name
it's horrid
it gets a lot more fun if it returns a struct
typedef struct int * (*name) (void);
that returns a pointer to a struct

typedef sometypename = typesig

typesig = name(
           | type(*)*([(n)?])*
           | union { (name|typesig)* }
	   | struct { (name|typesig)* }
	   

enum {
a,
b = 4,
c
}
     
union {
 x | a
 y | b
}
 
struct {
  x | sometime
  y | someothertype
}
  

typedef Point = struct {
  x | int
  y | int
}
-}

data AcppType = AcppTypeName String
              | AcppPointer AcppType
              | AcppArrayType (Maybe Integer) AcppType
              | AcppStructType [AcppTypeSig]
              | AcppUnionType [AcppTypeSig]
              | AcppFuncType [AcppType] AcppType 
           deriving (Show, Eq)
           
data AcppTypeSig = AcppTypeSig String AcppType deriving (Show, Eq)
           
data AcppStatement = StatementExpr AcppExpr
                   | StatementTypeSig AcppTypeSig
                   | StatementFunctionDef AcppFunctionDef
              deriving (Show, Eq)

data AcppFunctionDef = AcppFunctionDef String [String] [AcppStatement] deriving (Show, Eq)

data AcppExpr = AcppCall String [AcppExpr]
              | AcppId String
              | AcppStringLiteral String
              | AcppCharLiteral Char
              | AcppIntegerLiteral Integer
              | AcppFloatLiteral Double
        deriving (Show, Eq)

semi :: Parser String
semi = Token.semi lexer
symbol :: String -> Parser String
symbol = Token.symbol lexer
parens :: Parser a -> Parser a
parens = Token.parens lexer
braces :: Parser a -> Parser a
braces = Token.braces lexer
brackets :: Parser a -> Parser a
brackets = Token.brackets lexer
integer :: Parser Integer
integer = Token.integer lexer
natural :: Parser Integer
natural = Token.natural lexer
float :: Parser Double
float = Token.float lexer
--naturalOrFloat = Token.naturalOrFloat lexer
stringLiteral :: Parser String
stringLiteral = Token.stringLiteral lexer
identifier :: Parser String
identifier = Token.identifier lexer
--letter = Token.letter lexer
reserved :: String -> Parser ()
reserved = Token.reserved lexer
reservedOp :: String -> Parser ()
reservedOp = Token.reservedOp lexer
whiteSpace :: Parser ()
whiteSpace = Token.whiteSpace lexer
comma :: Parser String
comma = Token.comma lexer

parseTypeSig :: Parser AcppTypeSig
parseTypeSig = (do
  name <- parseVar
  reservedOp "|"
  accpType <- parseType
  return $ AcppTypeSig name accpType) <?> "type signature"

parseType :: Parser AcppType
parseType = do
  baseType <- parseTypeFactor
  suffixes <- many $ parseTypeSuffix
  return $ foldl (flip ($)) baseType suffixes
  
parseTypeName :: Parser AcppType
parseTypeName = liftM AcppTypeName identifier

parseTypeFactor :: Parser AcppType
parseTypeFactor = parseStructType  -- #TODO add union and struct as reserved words, then maybe put parseTypeName on top
              <|> parseUnionType
              <|> parseTypeName
              <?> "simple type expression"

parseTypeSuffix :: Parser (AcppType -> AcppType)
parseTypeSuffix = parsePointerTypePostfix
              <|> parseArrayTypePostfix
              <|> parseFunctionTypePostfix
              <?> "type suffix"
              
parseArrayTypePostfix :: Parser (AcppType -> AcppType)
parseArrayTypePostfix = do
  arrayIndex <- brackets $ optionMaybe natural
  return $ AcppArrayType arrayIndex

parsePointerTypePostfix ::  Parser (AcppType -> AcppType)
parsePointerTypePostfix = reservedOp "*" >> return AcppPointer

parseFunctionTypePostfix :: Parser (AcppType -> AcppType)
parseFunctionTypePostfix = do 
  paramTypes <- parens $ sepBy parseType comma 
  return $ AcppFuncType paramTypes

parseUnionType :: Parser AcppType
parseUnionType = do 
  reserved "union"
  body <- braces $ many parseTypeSig
  return $ AcppUnionType body

parseStructType :: Parser AcppType
parseStructType = do
  reserved "struct"
  body <- braces $ many parseTypeSig
  return $ AcppStructType body

parseVar :: Parser String
parseVar = identifier  
  
parseId :: Parser AcppExpr
parseId = liftM AcppId parseVar
parseStringLiteral :: Parser AcppExpr
parseStringLiteral = liftM AcppStringLiteral stringLiteral
parseIntegerLiteral :: Parser AcppExpr
parseIntegerLiteral = liftM AcppIntegerLiteral integer
parseFloatLiteral :: Parser AcppExpr
parseFloatLiteral = liftM AcppFloatLiteral float
--parseCallPostfix :: Parser [AcppExpr]
--parseCallPostfix = parens $ many parseExpr

parseCall :: Parser AcppExpr
parseCall = do
  name <- parseVar
  args <- parens $ many parseExpr
  return $ AcppCall name args

parseFactor :: Parser AcppExpr
parseFactor = try parseCall
          <|> parseId
          <|> parseStringLiteral
          <|> parseIntegerLiteral
          <|> parseFloatLiteral
          <|> (parens parseExpr)
          <?> "factor"

parseEndingSemi :: Parser a -> Parser a
parseEndingSemi p = p >>= \x -> semi >> return x

parseStatement :: Parser AcppStatement
parseStatement = liftM StatementExpr (parseEndingSemi parseExpr)
             <|> liftM StatementTypeSig (parseEndingSemi parseTypeSig)
             <|> liftM StatementFunctionDef parseFunctionDef
             <?> "statement"

parseExpr :: Parser AcppExpr
parseExpr = buildExpressionParser opTable parseFactor
        <?> "expression"

binaryOperator :: String -> AcppExpr -> AcppExpr -> AcppExpr
binaryOperator name a b = AcppCall name [a, b]

unaryOperator :: String -> AcppExpr -> AcppExpr
unaryOperator name a = AcppCall name [a]

mkUnaryOp :: String -> Parser (AcppExpr -> AcppExpr)
mkUnaryOp s = do
  reservedOp s
  return $ unaryOperator s

type AcppOperator a = Operator String () Identity a 

makeInfixOp :: String -> Assoc -> AcppOperator AcppExpr
makeInfixOp s a = Infix (do
  reservedOp s
  return $ binaryOperator s) a

makePrefixOp :: String -> AcppOperator AcppExpr
makePrefixOp s = Prefix $ mkUnaryOp s

makePostfixOp :: String -> AcppOperator AcppExpr
makePostfixOp s = Postfix $ mkUnaryOp s
  
opTable :: [[AcppOperator AcppExpr]]
opTable = [[makeInfixOp "*" AssocLeft, makeInfixOp "/" AssocLeft]
          ,[makeInfixOp "+" AssocLeft, makeInfixOp "-" AssocLeft]
          ,[makeInfixOp "=" AssocRight]
          ]

-- #TODO possibly replace parseVar with just identifier
-- asdf(a, b, c, d) { bla;bla;bla}
parseFunctionDef :: Parser AcppFunctionDef
parseFunctionDef = do
  name <- parseVar
  params <- parens $ sepBy parseVar comma
  body <- braces $ many parseStatement 
  return $ AcppFunctionDef name params body

parseLex :: Parser a -> Parser a
parseLex p = do 
  whiteSpace
  x <- p
  eof
  return x

parseFile :: Parser [AcppStatement]
parseFile = parseLex $ many parseStatement

{-
duplicate function names checked on conversion (at end of process)
graph does not have functions in functions
functiondef in graph has defintions and list of expr
perhaps have two graphs, a function graph, and a expr graph, no cause then a dereferencing operator wouldn't
be able to give a reference to a function, no that's not right... and id is already an expr, we are talking about
 function defititions...so yes two graphs would be better ... maybe....

-}






